home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue29 / web / FDIARY.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-07-12  |  3.8 KB  |  127 lines
  1. unit fdiary;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, HTTPApp, Db, DBTables;
  7.  
  8. type
  9.   TWebModule1 = class(TWebModule)
  10.     ppDiary: TPageProducer;
  11.     Table1: TTable;
  12.     procedure HandleEntry(Sender: TObject; Request: TWebRequest;
  13.       Response: TWebResponse; var Handled: Boolean);
  14.     procedure AddUser(Sender: TObject; Request: TWebRequest;
  15.       Response: TWebResponse; var Handled: Boolean);
  16.     procedure ppDiaryHTMLTag(Sender: TObject; Tag: TTag;
  17.       const TagString: String; TagParams: TStrings;
  18.       var ReplaceText: String);
  19.   private
  20.     { Private declarations }
  21.     FDate: TDatetime;
  22.     FUserName, FEntry: string;
  23.     FUserID: integer;
  24.   public
  25.     { Public declarations }
  26.   end;
  27.  
  28. var
  29.   WebModule1: TWebModule1;
  30.  
  31. implementation
  32.  
  33. {$R *.DFM}
  34.  
  35. procedure TWebModule1.HandleEntry(Sender: TObject; Request: TWebRequest;
  36.   Response: TWebResponse; var Handled: Boolean);
  37. const FILENAME: string = 'c:\program files\borland\delphi 3\web\newuser.htm';
  38. begin
  39.   // check if the cookies have been sent - if they have, then present the
  40.   // form to the surfer otherwise get the surfer to sign up for the diary
  41.  
  42.   with Request do
  43.   begin
  44.     fusername := CookieFields.Values['username'];
  45.     if FUserName <> EmptyStr then
  46.       fuserid := StrToInt(CookieFields.Values['userid'])
  47.     else fuserid := 0;
  48.   end;
  49.  
  50.   if (fusername = EmptyStr) or (fuserid <= 0) or
  51.     (Request.QueryFields.Values['deluser'] <> EmptyStr) then
  52.     Response.ContentStream := TFileStream.Create(FILENAME, fmOpenRead)
  53.   else with Request, Table1 do
  54.   begin
  55.     if QueryFields.Values['send'] <> EmptyStr then
  56.     begin
  57.       fdate := StrToDate(QueryFields.Values['adate']);
  58.       messagebeep($ffffffff);
  59.       if not Table1.FindKey([fuserid, fdate]) then
  60.       begin
  61.         Insert;
  62.         FieldByName('userid').AsInteger  := fuserid;
  63.         FieldByName('username').AsString := fusername;
  64.         FieldByName('date').AsDateTime   := fdate;
  65.       end else Edit;
  66.       FEntry := QueryFields.Values['donetoday'];
  67.       FieldByName('Entry').AsString := FEntry;
  68.       Post;
  69.       Response.Content := ppDiary.Content;
  70.     end
  71.     else if QueryFields.Values['getdate'] <> EmptyStr then
  72.     begin
  73.       fdate := StrToDate(QueryFields.Values['adate']);
  74.       if not Table1.FindKey([fuserid, fdate]) then
  75.       begin
  76.         Response.Content := '<H2>Sorry ' + fusername + ' the date ' +
  77.           DateToStr(fdate) + ' isn''t in your diary</H2>';
  78.         Exit;
  79.       end;
  80.       FDate  := FieldByName('Date').AsDateTime;
  81.       FEntry := FieldByName('Entry').AsString;
  82.       Response.Content := ppDiary.Content;
  83.     end else Response.Content := ppDiary.Content;
  84.   end;
  85. end;
  86.  
  87. procedure TWebModule1.AddUser(Sender: TObject; Request: TWebRequest;
  88.   Response: TWebResponse; var Handled: Boolean);
  89. var TheCookies: TStringList;
  90. begin
  91.   with Request do
  92.   try
  93.     FUserID   := GetTickCount;
  94.     FUserName := QueryFields.Values['username'];
  95.     FEntry    := 'Enter the day''s details here';
  96.     FDate     := now;
  97.  
  98.     TheCookies := nil;
  99.     TheCookies := TStringList.Create;
  100.     TheCookies.Add('username=' + fusername);
  101.     TheCookies.Add('userid=' + IntToStr(fuserid));
  102.  
  103.     Response.SetCookieField(TheCookies, '', '/', EncodeDate(1999, 12, 31), False);
  104.     Response.Content := ppDiary.Content;
  105.   finally
  106.     TheCookies.Free;
  107.   end
  108. end;
  109.  
  110. procedure TWebModule1.ppDiaryHTMLTag(Sender: TObject; Tag: TTag;
  111.   const TagString: String; TagParams: TStrings; var ReplaceText: String);
  112. begin
  113.   if CompareText(TagString, 'DIARYDATE') = 0 then
  114.     ReplaceText := DateToStr(FDate)
  115.   else
  116.   if CompareText(TagString, 'DIARYENTRY') = 0 then
  117.     ReplaceText := FEntry
  118.   else
  119.   if CompareText(TagString, 'DIARYTODAY') = 0 then
  120.     ReplaceText := DateToStr(now)
  121.   else
  122.   if CompareText(TagString, 'DIARYNAME') = 0 then
  123.     ReplaceText := FUserName;
  124. end;
  125.  
  126. end.
  127.